home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / MacOberon / MacOberon (tools) / TestElems.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1990-12-13  |  6.3 KB  |  130 lines  |  [.Ob./.Ob2]
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. Syntax10b.Scn.Fnt
  4. MODULE TestElems;    (** CAS 15-Oct-90 **)
  5.     IMPORT
  6.         Oberon, Input, Display, Viewers, Files, Fonts, Printer, Texts,
  7.         WriteTexts, WriteFrames, WriteParcs;
  8.     CONST
  9.         mm = WriteTexts.mm;
  10.         rightKey = 0; middleKey = 1; leftKey = 2;
  11.     TYPE
  12.         TestElem = POINTER TO TestElemDesc;
  13.         TestElemDesc = RECORD(WriteTexts.ElemDesc)
  14.             data: ARRAY 8 OF CHAR
  15.         END;
  16.         NotifyMsg = RECORD(WriteFrames.NotifyMsg) END;
  17.     PROCEDURE WriteString(VAR r: Files.Rider; s: ARRAY OF CHAR);
  18.         VAR i: INTEGER;
  19.     BEGIN i := 0;
  20.         WHILE s[i] # 0X DO INC(i) END;
  21.         Files.WriteBytes(r, s, i + 1)
  22.     END WriteString;
  23.     PROCEDURE ReadString(VAR r: Files.Rider; VAR s: ARRAY OF CHAR);
  24.         VAR i: INTEGER; ch: CHAR;
  25.     BEGIN i := 0;
  26.         REPEAT Files.Read(r, ch); s[i] := ch; INC(i) UNTIL (ch = 0X) OR (i = LEN(s));
  27.         IF ch # 0X THEN s[0] := 0X END
  28.     END ReadString;
  29.     PROCEDURE* TestHandle(E: WriteTexts.Elem; VAR msg: Display.FrameMsg);
  30.         VAR e: TestElem; P: WriteTexts.Parc; x, y, w, h: INTEGER; keys, keysum: SET; visible: BOOLEAN;
  31.             fnt: Fonts.Font; col: SHORTINT; X0, Y0: INTEGER;
  32.     BEGIN
  33.         WITH E: TestElem DO
  34.             IF msg IS WriteFrames.PrepareMsg THEN    (*element is about to be drawn or printed*)
  35.                 WITH msg: WriteFrames.PrepareMsg DO    (*automatically adopt measures to element's environment*)
  36.                     P := WriteTexts.ParcBefore(WriteTexts.ElemBase(E), WriteTexts.ElemPos(E));
  37.                     E.H := P.lsp    (*; E.W := P.width - msg.indent    would adapt to remaining space in line*)
  38.                 END
  39.             ELSIF msg IS WriteTexts.DrawMsg THEN    (*element is fully visible: draw it to the screen*)
  40.                 WITH msg: WriteTexts.DrawMsg DO
  41.                     Display.ReplConst(15, msg.X0, msg.Y0, SHORT(E.W DIV msg.unit), SHORT(E.H DIV msg.unit),
  42.                         Display.replace)
  43.                 END
  44.             ELSIF msg IS WriteTexts.PrintMsg THEN    (*element is fully visible: print it*)
  45.                 WITH msg: WriteTexts.PrintMsg DO
  46.                     Printer.Line(msg.X0, msg.Y0, SHORT(E.W DIV msg.unit), SHORT(E.H DIV msg.unit))
  47.                 END
  48.             ELSIF msg IS NotifyMsg THEN    (*special viewer broadcast message*)
  49.                 WITH msg: NotifyMsg DO
  50.                     WriteFrames.LocateElem(msg.frame, E, visible, fnt, col, X0, Y0);    (*check if indeed visible, i.e. not clipped*)
  51.                     IF visible THEN    (*if so: update the single view in this frame*)
  52.                         Display.ReplConst(15, X0 + 1, Y0 + 1, SHORT(E.W DIV msg.unit) - 2, SHORT(E.H DIV msg.unit) - 2,
  53.                             Display.invert)
  54.                     END
  55.                 END
  56.             ELSIF msg IS WriteTexts.LoadMsg THEN    (*load element specific data*)
  57.                 WITH msg: WriteTexts.LoadMsg DO
  58.                     ReadString(msg.r, E.data)
  59.                 END
  60.             ELSIF msg IS WriteTexts.StoreMsg THEN    (*store element specific data*)
  61.                 WITH msg: WriteTexts.StoreMsg DO
  62.                     WriteString(msg.r, "TestElems.Alloc");    (*always write out the name of the allocation procedure first*)
  63.                     WriteString(msg.r, E.data)
  64.                 END
  65.             ELSIF msg IS WriteTexts.CopyMsg THEN    (*copy element*)
  66.                 WITH msg: WriteTexts.CopyMsg DO
  67.                     IF msg.e = NIL THEN NEW(e); msg.e := e ELSE e := msg.e(TestElem) END;    (*if not yet allocated: do so*)
  68.                     e.data := E.data    (*copy state into new element*)
  69.                 END
  70.             ELSIF msg IS WriteFrames.TrackMsg THEN    (*a mouse click hit the element*)
  71.                 WITH msg: WriteFrames.TrackMsg DO 
  72.                     IF msg.keys = {middleKey} THEN keysum := msg.keys;
  73.                         w := SHORT(E.W DIV msg.unit); h := SHORT(E.H DIV msg.unit);
  74.                         Oberon.RemoveMarks(msg.X0, msg.Y0, w, h);
  75.                         Display.ReplConst(15, msg.X0 + 1, msg.Y0 + 1, w - 2, h - 2, Display.invert);
  76.                         REPEAT Input.Mouse(keys, msg.X, msg.Y); keysum := keysum + keys;
  77.                             Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, msg.X, msg.Y)
  78.                         UNTIL keys = {};
  79.                         Display.ReplConst(15, msg.X0 + 1, msg.Y0 + 1, w - 2, h - 2, Display.invert);
  80.                         IF (keysum = {middleKey, leftKey}) & (E.W > 4 * mm) THEN DEC(E.W, 2 * mm); E.DX := E.W + 2 * mm;
  81.                             WriteTexts.ChangedElem(E)
  82.                         ELSIF msg.keys = {middleKey, rightKey} THEN INC(E.W, 2 * mm); E.DX := E.W + 2 * mm;
  83.                             WriteTexts.ChangedElem(E)
  84.                         END
  85.                     END
  86.                 END
  87.             END
  88.         END
  89.     END TestHandle;
  90.     PROCEDURE* MiscHandle(E: WriteTexts.Elem; VAR msg: Display.FrameMsg);    (*subclass handler of TestHandle*)
  91.     BEGIN
  92.         WITH E: TestElem DO
  93.             IF msg IS WriteTexts.StoreMsg THEN
  94.                 WITH msg: WriteTexts.StoreMsg DO    (*write the name of a nonexistent procedure -> cannot be loaded again*)
  95.                     WriteString(msg.r, "TestElems.Unknown");
  96.                     WriteString(msg.r, E.data)
  97.                 END
  98.             ELSE TestHandle(E, msg)
  99.             END
  100.         END
  101.     END MiscHandle;
  102.     PROCEDURE Alloc*;    (*allocation procedure for class TestElem; allocates specific element and installs handler*)
  103.         VAR e: TestElem;
  104.     BEGIN NEW(e); e.handle := TestHandle; Oberon.Par(WriteTexts.AllocPar).e := e
  105.     END Alloc;
  106.     PROCEDURE InsertNew*;    (** W H demonstrates behaviour of trivial floating element**)
  107.         VAR S: Texts.Scanner; w: LONGINT;
  108.             e: TestElem; T: WriteTexts.Text; copyover: Oberon.CopyOverMsg;
  109.     BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); w := S.i; Texts.Scan(S);
  110.         NEW(e); WriteTexts.OpenElem(e, TestHandle, (w + 2)*mm, w*mm, S.i*mm); e.data := "testing";
  111.         T := WriteFrames.Text("", WriteParcs.defParc); WriteTexts.AppendElem(T, e);
  112.         copyover.text := T; copyover.beg := 0; copyover.end := T.len;
  113.         Oberon.FocusViewer.handle(Oberon.FocusViewer, copyover)
  114.     END InsertNew;
  115.     PROCEDURE InsertMisc*;    (** W H demonstrates handling of elements which cannot be loaded on opening**)
  116.         VAR S: Texts.Scanner; w: LONGINT;
  117.             e: TestElem; T: WriteTexts.Text; copyover: Oberon.CopyOverMsg;
  118.     BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); w := S.i; Texts.Scan(S);
  119.         NEW(e); WriteTexts.OpenElem(e, MiscHandle, (w + 2)*mm, w*mm, S.i*mm); e.data := "testing";
  120.         T := WriteFrames.Text("", WriteParcs.defParc); WriteTexts.AppendElem(T, e);
  121.         copyover.text := T; copyover.beg := 0; copyover.end := T.len;
  122.         Oberon.FocusViewer.handle(Oberon.FocusViewer, copyover)
  123.     END InsertMisc;
  124.     PROCEDURE Broadcast*;    (**demonstrate effect of special viewer broadcast message**)
  125.         VAR msg: NotifyMsg;
  126.     BEGIN Viewers.Broadcast(msg)
  127.     END Broadcast;
  128. END TestElems.
  129. WriteParcs.Alloc
  130.